Homework 12
Ethan Thibault
4/11/2018
Here is Homework 11. The data I will be using is Julian Days to bud flush for different genotypes of Balsam Poplar across a variety of lengths of chilling.
# Preliminaries
library(ggplot2)
library(ggthemes)## Warning: package 'ggthemes' was built under R version 3.4.4# First I need to read in my dataset (I am going to copy in some code from my own code that will bring in a file and alter it into usable data)
setwd("~/Documents/UVM_2018/BIO381")
#+++++++++++++++++++++++++
# Function to calculate the mean and the standard deviation
# for each group
#+++++++++++++++++++++++++
# data : a data frame
# varname : the name of a column containing the variable
#to be summariezed
# groupnames : vector of column names to be used as
# grouping variables
data_summary <- function(data, varname, groupnames){
require(plyr)
summary_func <- function(x, col){
c(mean = mean(x[[col]], na.rm=TRUE),
sd = sd(x[[col]], na.rm=TRUE))
}
data_sum<-ddply(data, groupnames, .fun=summary_func,
varname)
data_sum <- rename(data_sum, c("mean" = varname))
return(data_sum)
}
chill <- read.csv("ChillingExpt.csv", header=T)
str(chill)## 'data.frame': 40 obs. of 13 variables:
## $ ind_code: Factor w/ 10 levels "CPL_03","CPL_10",..: 3 3 10 10 5 5 2 2 8 8 ...
## $ SampleID: num 1 1 2 2 3 3 4 4 5 5 ...
## $ JulBF_0 : int 32 35 32 30 34 36 39 38 56 47 ...
## $ JulBF_1 : int NA 33 33 35 41 40 40 47 56 54 ...
## $ JulBF_2 : int 44 44 40 41 45 41 46 48 56 56 ...
## $ JulBF_3 : int NA 54 45 45 48 48 59 53 60 57 ...
## $ JulBF_4 : int 54 62 47 50 58 53 58 57 NA 73 ...
## $ JulBF_5 : int 60 64 55 53 62 65 60 63 81 73 ...
## $ JulBF_6 : int 68 77 62 61 71 71 78 85 82 NA ...
## $ JulBF_7 : int 82 84 69 69 74 74 76 80 87 84 ...
## $ JulBF_8 : int NA NA 76 74 81 85 82 83 87 87 ...
## $ JulBF_9 : int NA NA 82 78 87 90 88 88 94 91 ...
## $ JulBF_10: int NA 87 84 84 94 94 91 90 NA 94 ...subtractor <- c(0,0,5,12,19,26,33,40,47,54,61,68,75)
# create a for loop that will subract the correct value from each column
for (i in 3:13) {
chill[,i] <- chill[,i] - subtractor[i]
}
summary(chill) ## ind_code SampleID JulBF_0 JulBF_1
## CPL_03 : 4 Min. : 1.00 Min. :20.00 Min. :13.00
## CPL_10 : 4 1st Qu.: 5.15 1st Qu.:26.00 1st Qu.:22.00
## FNO_12 : 4 Median :11.00 Median :29.50 Median :26.00
## FNO_15 : 4 Mean :10.72 Mean :31.06 Mean :28.38
## HWK_11 : 4 3rd Qu.:16.25 3rd Qu.:35.50 3rd Qu.:33.50
## HWK_14 : 4 Max. :20.00 Max. :51.00 Max. :68.00
## (Other):16 NA's :4 NA's :1
## JulBF_2 JulBF_3 JulBF_4 JulBF_5
## Min. :13.00 Min. :12.00 Min. :12.00 Min. :11.00
## 1st Qu.:22.00 1st Qu.:20.00 1st Qu.:18.00 1st Qu.:16.00
## Median :26.00 Median :23.00 Median :24.00 Median :22.00
## Mean :27.63 Mean :24.21 Mean :23.31 Mean :22.35
## 3rd Qu.:33.50 3rd Qu.:28.00 3rd Qu.:29.00 3rd Qu.:27.00
## Max. :54.00 Max. :34.00 Max. :40.00 Max. :41.00
## NA's :5 NA's :7 NA's :1 NA's :3
## JulBF_6 JulBF_7 JulBF_8 JulBF_9
## Min. :13.00 Min. :11.00 Min. : 8.00 Min. : 8.00
## 1st Qu.:19.00 1st Qu.:15.00 1st Qu.:14.00 1st Qu.:15.00
## Median :26.00 Median :20.00 Median :19.00 Median :20.00
## Mean :25.89 Mean :21.06 Mean :18.54 Mean :18.21
## 3rd Qu.:33.00 3rd Qu.:27.00 3rd Qu.:22.50 3rd Qu.:22.00
## Max. :44.00 Max. :33.00 Max. :29.00 Max. :26.00
## NA's :3 NA's :5 NA's :5 NA's :11
## JulBF_10
## Min. : 9.00
## 1st Qu.:12.00
## Median :15.00
## Mean :14.84
## 3rd Qu.:18.00
## Max. :19.00
## NA's :15chill2 <- reshape(chill, varying=3:13, sep="_", direction="long")
str(chill2)## 'data.frame': 440 obs. of 5 variables:
## $ ind_code: Factor w/ 10 levels "CPL_03","CPL_10",..: 3 3 10 10 5 5 2 2 8 8 ...
## $ SampleID: num 1 1 2 2 3 3 4 4 5 5 ...
## $ time : num 0 0 0 0 0 0 0 0 0 0 ...
## $ JulBF : num 27 30 27 25 29 31 34 33 51 42 ...
## $ id : int 1 2 3 4 5 6 7 8 9 10 ...
## - attr(*, "reshapeLong")=List of 4
## ..$ varying:List of 1
## .. ..$ JulBF: chr "JulBF_0" "JulBF_1" "JulBF_2" "JulBF_3" ...
## .. ..- attr(*, "v.names")= chr "JulBF"
## .. ..- attr(*, "times")= num 0 1 2 3 4 5 6 7 8 9 ...
## ..$ v.names: chr "JulBF"
## ..$ idvar : chr "id"
## ..$ timevar: chr "time"summary(chill2)## ind_code SampleID time JulBF
## CPL_03 : 44 Min. : 1.00 Min. : 0 Min. : 8.00
## CPL_10 : 44 1st Qu.: 5.15 1st Qu.: 2 1st Qu.:18.00
## FNO_12 : 44 Median :11.00 Median : 5 Median :22.00
## FNO_15 : 44 Mean :10.72 Mean : 5 Mean :23.61
## HWK_11 : 44 3rd Qu.:16.25 3rd Qu.: 8 3rd Qu.:29.00
## HWK_14 : 44 Max. :20.00 Max. :10 Max. :68.00
## (Other):176 NA's :60
## id
## Min. : 1.00
## 1st Qu.:10.75
## Median :20.50
## Mean :20.50
## 3rd Qu.:30.25
## Max. :40.00
## head(chill2)## ind_code SampleID time JulBF id
## 1.0 FNO_12 1 0 27 1
## 2.0 FNO_12 1 0 30 2
## 3.0 SKN_10 2 0 27 3
## 4.0 SKN_10 2 0 25 4
## 5.0 HWK_11 3 0 29 5
## 6.0 HWK_11 3 0 31 6with(chill2, plot(time, JulBF))
# There is a bump in Jul days to BF at about 6 weeks of chilling. We determined that this is most likely due to the malfunctioning growth chamber that occurred a few days after week 6 was planted. We believe the interrupted 24 hour light (by 4 hours of darkness) is giving us this bump.
chill3 <- data_summary(chill2, varname="JulBF",
groupnames=c("time","ind_code"))## Loading required package: plyr# chill3 is now in the long format with means and standard deviations
#-----------------------------------------------------------------------
# the code that follows will now be what I do in class for the homework assignment
# Here is a basic plot
p1 <- ggplot(data=chill3, mapping = aes(x=time,y=JulBF)) + geom_point()
print(p1)
# Now I will try adding themes found in ggthemes
p1 + theme_pander()
p1 + theme_hc()
p1 + theme_calc()
p1 + theme_stata()
p1 + theme_tufte()
p1 + theme_wsj()
# ooh i like that one...
p1 + theme_wsj(base_size = 10,base_family = "serif")
# Now I want to add the individuals to my plot
p2 <- ggplot(data=chill3,mapping=aes(x=time,y=JulBF,col=ind_code)) + geom_point() + theme_wsj(base_size = 10,base_family = "serif")
print(p2)
# now add a smoothing line
p2 + geom_smooth()## `geom_smooth()` using method = 'loess'
# remove confidence intervals
p2 + geom_smooth(se=FALSE)## `geom_smooth()` using method = 'loess'
p2 + geom_smooth(se = FALSE, method = "glm")
p2 + geom_smooth(se = FALSE, method = "gam")
# The following is my graph up to now and I will try playing around with faceting
p3 <- ggplot(data=chill3,mapping=aes(x=time,y=JulBF, color=ind_code)) + geom_point() + theme_wsj(base_size = 10,base_family = "serif") + geom_smooth(se = FALSE)
print(p3)## `geom_smooth()` using method = 'loess'
p3 + facet_grid(ind_code~.)## `geom_smooth()` using method = 'loess'
p3 + facet_grid(.~ind_code)## `geom_smooth()` using method = 'loess'
p3 + facet_grid(time~ind_code)## `geom_smooth()` using method = 'loess'
p3 + facet_grid(ind_code~time)## `geom_smooth()` using method = 'loess'
p3 + facet_grid(time~.)## `geom_smooth()` using method = 'loess'
p3 + facet_grid(.~time)## `geom_smooth()` using method = 'loess'
# faceting doesn't seem to work well with my data
# Now I will try doing a little more and see if I can add error bars to my points with the standard deviation in my data frame
p4 <- ggplot(chill3, aes(x=time, y=JulBF, color=ind_code)) +
geom_line() +
geom_point() +
theme_wsj(base_size = 10,base_family = "serif") +
geom_errorbar(aes(ymin=JulBF-sd, ymax=JulBF+sd), width=.2,
position=position_dodge(0.05))
print(p4)## Warning: Removed 5 rows containing missing values (geom_errorbar).
p4 <- ggplot(chill3, aes(x=time, y=JulBF, color=ind_code)) +
geom_line() +
geom_point() +
theme_wsj(base_size = 10,base_family = "serif") +
geom_errorbar(aes(ymin=JulBF-sd, ymax=JulBF+sd), width=.2,
position=position_dodge(0.05)) +
facet_grid(ind_code~., scales = "free_y")
print(p4)## Warning: Removed 5 rows containing missing values (geom_errorbar).
p5 <- ggplot(chill3, aes(x=time, y=JulBF, color=ind_code)) +
geom_line() +
geom_point() +
theme_wsj(base_size = 10,base_family = "serif") +
geom_errorbar(aes(ymin=JulBF-sd, ymax=JulBF+sd), width=.2,
position=position_dodge(0.05)) +
facet_grid(.~ind_code, scales = "free_y")
print(p5)## Warning: Removed 5 rows containing missing values (geom_errorbar).